home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / flist < prev    next >
Text File  |  1996-09-05  |  17KB  |  515 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  3. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  4. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  5. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  6. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  7. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  8.  
  9. -- flist.sa: Array-based lists of elements of type T.
  10. -- Jan4/96 - incorporated Erik Schnetter's changes.
  11. -------------------------------------------------------------------
  12. class FLIST{T} < $ARR{T} is
  13.     -- Array-based lists of elements of type T.  These are extensible
  14.     -- stacks based on amortized doubling.  They may often be used as
  15.     -- replacements for linked lists.  Like linked lists (which are
  16.     -- widely used as containers in languages like Lisp), they serve
  17.     -- as general container objects for holding collections of other
  18.     -- objects. They are often a more efficient abstraction, however,
  19.     -- because less allocation and deallocation must occur, because
  20.     -- they keep successive elements in successive memory locations,
  21.     -- because they don't require storage for the links in a linked
  22.     -- list, and they support efficient access by array index.  Linked
  23.     -- lists also support insertion and deletion into the middle of
  24.     -- the list.  The set operations `union', `intersection',
  25.     -- `difference', and `sym_difference' and the searching operation
  26.     -- `index_of' are implemented by brute force search. If extensive
  27.     -- use is made of these operations, one should consider the use of
  28.     -- other data structures such as FSET{T}.
  29.    include COMPARE{T};
  30.    
  31.    private include AREF{T} aget->private aref_aget, 
  32.      aset->private aref_aset;    -- Storage for the stack elements.
  33.    
  34.    private attr loc:INT;    -- The index to insert the next element.
  35.    
  36.       
  37.    -- It would be nice to use an invariant here, but for 
  38.    -- efficiency we want to be able to destroy old objects
  39.    -- after a size change occurs (requiring the writeback).
  40.    -- Such calls destroy self, and so the invariant can't
  41.    -- be called.
  42.  
  43.     --invariant:BOOL is        
  44.     --  -- Illegal state if false.
  45.     --  if void(self) then return true end;
  46.     --  return loc.is_bet(0,asize) and asize>0 end;
  47.     
  48.     size:INT is
  49.     -- The current size. Self may be void.
  50.     if void(self) then return 0 else return loc end end;
  51.     
  52.     create:SAME is return void; end;
  53.  
  54.     create(n:INT):SAME
  55.     -- A new empty FLIST capable of storing `n' elements without extra
  56.     -- space allocation.
  57.     pre n>=0 is 
  58.     if n=0 then return void
  59.     else return new(n)
  60.     end;
  61.     end;
  62.  
  63.    create(a: ARRAY{T}): SAME is
  64.       -- Create a new FLIST from the elements in the array "a"
  65.       -- Useful for using the array shorthand for specifying the elements
  66.       sz ::= a.size;
  67.       res ::= new(sz);
  68.       res.loc := sz;
  69.       i ::= 0; loop until!(i = sz); res[i] := a[i]; i := i + 1; end;
  70.       return res;
  71.    end;
  72.    
  73.    create_from(a: $ELT{T}): SAME is
  74.       -- Create from any container
  75.       res ::= #SAME;
  76.       loop res := res.push(a.elt!) end;
  77.       return res;
  78.    end;
  79.      
  80.    create_empty_sized(n: INT): SAME  
  81.    -- Create an flist with n elements that are set to elt_nil
  82.       pre n >= 0
  83.    is
  84.       res ::= create(n);
  85.       res.loc := n;
  86.       loop res.aset!(res.elt_nil) end;
  87.       return res;
  88.    end;
  89.  
  90.     copy:SAME is
  91.       -- A copy of self.
  92.       -- Modified (ben) - ask Claudio
  93.     if void(self) then return void end;
  94.     r::=new(asize); 
  95.     i ::= 0; sz ::= loc;
  96.     r.loc := loc;
  97.     loop until!(i = sz); r[i] := [i]; i := i + 1; end;
  98.     return r;
  99.     -- loop r:=r.push(elt!) end; return r 
  100.      end;
  101.     
  102.    aget(ind:INT):T            
  103.     -- The element of self with index `ind'. Self may not be void.
  104.     pre ~void(self) and ind.is_bet(0,loc-1) is
  105.     return aref_aget(ind) end;
  106.  
  107.     aset(ind:INT,val:T)
  108.     -- Set the element of self with index `ind' to `val'. Self may
  109.     -- not be void. 
  110.     pre ~void(self) and ind.is_bet(0,loc-1) is 
  111.     aref_aset(ind,val) end;
  112.     
  113.     push(e:T):SAME is
  114.     -- Add a new element to the end of the list and return the list.
  115.     -- If self is void, create a new list. Usage: `l:=l.push(e)'.
  116.     r:SAME;
  117.     if void(self) then r:=new(5)
  118.     elsif loc<asize then r:=self
  119.     else r:=new(2*asize); r.loc:=loc; 
  120.         loop r.aset!(elt!) end;
  121.         -- clear;
  122.         SYS::destroy(self);  -- The old one should never be used.
  123.     end;
  124.     r.loc:=r.loc+1; r[r.loc-1]:=e; return r end;
  125.  
  126.     pop:T is
  127.     -- Return the top element and shrink the list.
  128.     -- Void if the list is empty or void.
  129.     if size=0 then return void end;
  130.     r::=[loc-1]; [loc-1]:=void; loc:=loc-1; return r end;
  131.  
  132.     top:T is
  133.     -- The value of the top of the list.
  134.     -- Void if the list is empty or void.
  135.     if size=0 then return void end;      
  136.     return [loc-1] end;
  137.  
  138.    equals(l: $RO_ARR{T}): BOOL is
  139.       -- Return true if the elemetns of "l" are the same as the elements
  140.       -- of self
  141.       if void(self) then return l.size = 0 end;
  142.       loop 
  143.      if ~elt_eq(elt!,l.elt!) then return false end;
  144.       end;
  145.       return true;
  146.    end;
  147.    
  148. --   is_eq(l:SAME):BOOL is
  149. --    -- True if self and `l' have the same number of elements and each
  150. --    -- element of self is equal to the corresponding element of `l'.
  151. --    -- Self may be void.
  152. --    -- Modified (ben)
  153. --    if void(self) then return l.size=0
  154. --    elsif void(l) then return loc=0
  155. --    elsif loc/=l.loc then return false
  156. --    else
  157. --       i ::= 0; sz ::= loc;
  158. --       loop until!(i = sz); 
  159. --          if ~elt_eq([i],l[i]) then return false end;
  160. --          i := i +1;
  161. --       end;
  162. --       --  loop if ~elt_eq(elt!,l.elt!) then return false end end end;
  163. --       return true 
  164. --    end;
  165. --     end;
  166.  
  167.     is_empty:BOOL is    
  168.     -- True if the list is empty or void.
  169.     return size=0 end;
  170.  
  171.     clear is            
  172.     -- Clear the list. Self may be void.  Clear array elements
  173.     -- so they won't be referenced any more (and may become garbage).
  174.     if is_empty then return
  175.     else 
  176.         nil: T; 
  177.         loop [size.times!]:= nil end;
  178.         loc:=0;
  179.     end;
  180.     end;
  181.     
  182.     reset is
  183.     -- Semantically identical to clear, but don't reset array
  184.     -- values (space may not be freed).  Useful for quickly
  185.     -- emptying the list when you know it won't matter.
  186.     if ~void(self) then loc := 0 end;
  187.     end;
  188.  
  189.     array:ARRAY{T} is        
  190.     -- An array containing the elements of self. Void if self is void.
  191.     if void(self) then return void end;
  192.     r::=#ARRAY{T}(loc); 
  193.     loop r.set!(elt!) end; return r end;
  194.     
  195.     elt!:T is
  196.     -- Yield the elements of self in order. Self may be void.
  197.     -- Don't insert elements while calling this.
  198.     -- Modified (ben) - must ask Claudio
  199.       if ~void(self) then 
  200.      i ::= 0; sz ::= loc;
  201.      loop until!(i = sz); yield [i]; i := i + 1; end;
  202.       end;
  203.    end;
  204. --        loop yield aelt!(0,loc) end end end;
  205.  
  206.     elt!(once beg:INT):T
  207.     -- Yield the elements of self starting at `beg'.
  208.     -- Don't insert elements while calling this.   
  209.     -- Modified (ben) - Looked at fast version - does 
  210.     -- not seem to be optimized out. Must ask Claudio about this
  211.       pre ~void(self) and beg.is_bet(0,loc-1) is
  212.       i ::= beg; sz ::= loc;
  213.       loop until!(i = sz); yield [i]; i := i + 1; end;
  214.    end;
  215. --    loop yield aelt!(beg,loc-beg) end end;     
  216.     
  217.     elt!(once beg,once  num:INT):T
  218.     -- Yield `num' successive elements starting at index `beg'.
  219.     -- Don't insert elements while calling this.      
  220.     pre ~void(self) and beg.is_bet(0,loc-1) and 
  221.     num.is_bet(0,loc-beg) is
  222.       i ::= beg; sz ::= loc.min(beg+num);
  223.       loop until!(i = sz); yield [i]; i := i + 1; end;
  224.    end;
  225. --      loop yield aelt!(beg,num) end end;
  226.  
  227.     private is_legal_elts_arg(beg,num,step:INT):BOOL is
  228.     -- True if the arguments are legal values for `elts'.
  229.     if ~beg.is_bet(0,loc-1) then return false end;
  230.     if step>0 then return num.is_bet(0,(loc-beg+step-1)/step);
  231.     elsif step<0 then return num.is_bet(0,(beg-step)/-step);
  232.     else return false end end;
  233.     
  234.     elt!(once beg,once  num,once  step:INT):T
  235.     -- Yield `num' elements starting at `beg' stepping by `step'.
  236.       pre ~void(self) and is_legal_elts_arg(beg,num,step) is
  237.       loop yield aelt!(beg,num,step) end end;
  238.     
  239.     ind!:INT is        
  240.     if ~void(self) then      
  241.         loop yield 0.upto!(loc-1) end end end;
  242.  
  243.     index_of(e:T):INT is
  244.     -- The list index of `e'. -1 if the list is void or the
  245.     -- element is not present (not fast). Consider using FSET{T}.
  246.     if ~void(self) then
  247.         loop r::=ind!; if elt_eq(e,[r]) then return r end end end;
  248.     return -1 end;   
  249.  
  250.    contains(e: T): BOOL is return has(e) end;
  251.    
  252.     has(e:T):BOOL is
  253.     -- True if `e' is contained in self.
  254.     loop if elt_eq(e,elt!) then return true end end;
  255.     return false end;
  256.     
  257.     push_if_new(e:T):SAME is
  258.     -- Push `e' if it is not already present in the list.
  259.     -- Self may be void. 
  260.     -- Usage is: `l:=l.push_if_new(e)'. Consider using FSET{T}.
  261.     if has(e) then return self else return push(e) end end;
  262.  
  263.     append(l:SAME):SAME 
  264.     -- Append `l' to the end of self and return the result.
  265.     -- Self may be void. `l' mustn't equal self unless void.
  266.     -- Modified(ben) - hopefully much more efficient - no iters
  267.       pre ~SYS::ob_eq(l,self) or void(self) is 
  268.       r::=copy; 
  269.       old_size ::= size;
  270.       r := r.expand_to_size(size+l.size);
  271.       i ::= old_size; sz ::= old_size+l.size;
  272.       li ::= 0; 
  273.       loop until!(i=sz); 
  274.      r[i] := l[li];
  275.      li := li+1;
  276.      i  := i + 1;
  277.       end; 
  278.       return r 
  279.    end;
  280.  
  281.     concat(l:SAME):SAME
  282.     -- Append 'l' destructively.  'l' mustn't equal self
  283.     -- unless void.
  284.     -- Modified (ben) - hopefully more efficient - no iters, single alloc
  285.       pre ~SYS::ob_eq(l,self) or void(self) is
  286.       res::=self;
  287.       if ~void(l) then 
  288.      oldsize ::= size;
  289.      res := res.expand_to_size(size+l.size);
  290.      i ::= 0; sz ::= l.size;
  291.      resi ::= oldsize;
  292.      loop until!(i = sz);
  293.         res[resi] := l[i];
  294.         i := i + 1;
  295.         resi := resi+1;
  296.      end;
  297.        -- Old version: res:=res.push(l.elt!) end 
  298.       end;
  299.       return (res);
  300.     end;
  301.  
  302.     union(l:SAME):SAME is
  303.     -- A new list containing the elements in self unioned with
  304.     -- those in `l'. Doesn't modify self or `l'. Self may be void.
  305.     -- Consider using FSET{T} for better performance.
  306.     r::=copy; loop r:=r.push_if_new(l.elt!) end; return r end;
  307.     
  308.     intersect(l:SAME):SAME is
  309.     -- A new list containing the elements in both self and `l'.
  310.     -- Doesn't modify self or `l'. Consider FSET{T} for better 
  311.     -- performance. Self may be void.
  312.     r:SAME;
  313.     loop e::=elt!; if l.has(e) then r:=r.push(e) end end;
  314.     return r end;
  315.     
  316.     difference(l:SAME):SAME is
  317.     -- A new list containing the elements of self not in `l'.
  318.     -- Doesn't modify self or `l'. Consider FSET{T} for better
  319.     -- performance. Self may be void.
  320.     r:SAME;
  321.     loop e::=elt!; if ~l.has(e) then r:=r.push(e) end end;
  322.     return r end;
  323.  
  324.     sym_difference(l:SAME):SAME is
  325.     -- A new list containing the elements in self or `l' but
  326.     -- not both. Doesn't modify self or `l'. Consider FSET{T} for
  327.     -- better performance. Self may be void.
  328.     r:SAME; 
  329.     loop e::=elt!; if ~l.has(e) then r:=r.push(e) end end;
  330.     loop e::=l.elt!; if ~has(e) then r:=r.push(e) end end;
  331.     return r end;
  332.  
  333.     sublist(beg,num:INT):SAME 
  334.     -- A new list with `num' entries copied from self starting
  335.     -- at `beg'. Self may not be void.
  336.     pre ~void(self) and
  337.     beg.is_bet(0,loc-1) and num.is_bet(0,loc-beg) is
  338.     r::=new(num+5); r.loc:=num; r.acopy(0,num,beg,self); return r end;
  339.  
  340.     to_reverse is
  341.     -- Reverse the order of the elements in self. Self may be void.
  342.     if void(self) then return end;
  343.     loop i::=(loc/2).times!; 
  344.         u::=loc-i-1; t::=[i]; [i]:=[u]; [u]:=t end end; 
  345.  
  346.    -- Users are advised to use this first set of routines
  347.    -- since these may later be rewritten to allow the FLIST
  348.    -- to shrink, which the versions without return values cannot do.
  349.    delete(ind: INT): SAME is delete(ind); return self end;
  350.    delete_elt(e: T): SAME is delete_elt(e); return self end;
  351.    delete_ordered(ind: INT): SAME is delete_ordered(ind); return self end;
  352.    delete_elt_ordered(e: T): SAME is delete_elt_ordered(e); return self end;
  353.    
  354.     delete(ind:INT) 
  355.     -- Delete the element with index `ind' and move the last element
  356.     -- in its place. Self may not be void.
  357.       pre ~void(self) and ind.is_bet(0,loc-1) is
  358.       [ind]:=[loc-1]; loc := loc - 1;  end;
  359.  
  360.    delete_elt(e: T) is  delete(index_of(e)) end;
  361.       -- Delete first occurance of element e from the list.
  362.       -- Consider using FSET.
  363.    
  364.    delete_ordered(ind: INT) 
  365.       -- Delete the element with index `ind' and move up all other
  366.       -- elements (thus preseving order). More expensive than
  367.       -- 'delete'. Self may not be void.
  368.       pre ~void(self) and ind.is_bet(0,loc-1) is
  369.       i ::= ind+1; loop until!(i>=size);
  370.      [i-1] := [i];
  371.      i := i+1;
  372.       end;
  373.       loc := loc -1;
  374.    end;
  375.    
  376.    delete_elt_ordered(e: T) is delete_ordered(index_of(e)) end;
  377.    -- Similar to delete_ord, but for the element "e"
  378.    
  379.    --    map(map:FMAP{T,T}):SAME is
  380.    --  Nobody here uses this routine, and it drags in a bunch of (possibly)
  381.    -- irrelevant stuff into every compile
  382. --    -- If an element of self is a key in FMAP
  383. --    -- it is replaced with the corresponding
  384. --    -- target. Self may be void.
  385. --    if void(self) then
  386. --        return void;
  387. --    else
  388. --        res::=copy;
  389. --        loop
  390. --        i::=0.upto!(loc-1);
  391. --        if map.test(res[i]) then
  392. --            res[i]:=map.get(res[i]);
  393. --        end;
  394. --        end;
  395. --        return res end end;
  396.  
  397.    has_ind(i: INT): BOOL is
  398.       return 0 <= i and i < size 
  399.    end;
  400.  
  401.    valid_after_ind(i: INT): BOOL is return -1 <= i and i < size end;
  402.    valid_before_ind(i:INT): BOOL is return 0 <=i and i <= size end;
  403.    
  404.    insert_after(ind:INT, val:T): SAME pre valid_after_ind(ind) is
  405.       -- Insert the value "val" after the index "ind".
  406.       -- push all later elements upwards.
  407.       r: SAME := expand_to_size(size+1);    
  408.       -- Then move all elements downwards
  409.       r.push_downward(ind+1,1);
  410.       r[ind+1] := val;
  411.       return r;
  412.    end;
  413.    
  414.    insert_before(ind:INT, val:T): SAME pre valid_before_ind(ind) is
  415.       -- Insert val just before index "ind"
  416.       r: SAME := expand_to_size(size+1);    
  417.       -- Then move all elements downwards, including the elt at "ind"
  418.       r.push_downward(ind,1);    
  419.       r[ind] := val;
  420.       return r;
  421.    end;
  422.    
  423.    insert_all_after(ind:INT, val:$CONTAINER{T}):SAME 
  424.       pre valid_after_ind(ind) is
  425.       -- Insert all the values in "val" after the index "ind"
  426.       -- in the order in which they are yielded by "val"      
  427.       r: SAME := expand_to_size(size+val.size);
  428.       r.push_downward(ind+1,val.size);
  429.       i ::= ind+1;  loop r[i] := val.elt!; i := i + 1; end;
  430.       return r
  431.    end;
  432.       
  433.    insert_all_before(ind:INT, val:$CONTAINER{T}) :SAME 
  434.       pre valid_before_ind(ind) is
  435.       -- Insert all the values in "val" before the index "ind"
  436.       -- in the order in which they are yielded by "val"
  437.       r: SAME := expand_to_size(size+val.size);
  438.       r.push_downward(ind,val.size);
  439.       i ::= ind;  loop r[i] := val.elt!; i := i + 1; end;
  440.       return r
  441.    end;
  442.  
  443.    str: STR is
  444.       -- Prints out a string version of the flist of the components 
  445.       -- that are under $STR
  446.       res ::= #FSTR("{");
  447.       i ::= 0;
  448.       loop until!(i = size);
  449.      e ::= [i];
  450.      if i > 0 then res := res+","+elt_str(e,i);
  451.      else  res := res + elt_str(e,i); end;
  452.      i := i + 1;
  453.       end;
  454.       res := res+"}";
  455.       return(res.str);
  456.    end;
  457.         
  458.    elt_str(e: T,i: INT): STR is
  459.       typecase e 
  460.       when $STR then return e.str else return "Unprintable:"+i.str end;
  461.    end;
  462.    -- ------------------- Implementation ------------------
  463.    private push_downward(from_ind: INT, by: INT) pre from_ind >= 0 is
  464.       -- Push all the elements from  index "from_ind" downward by
  465.       -- "ind" spots. The last elements are pushed off the end
  466.       to ::= size-1;
  467.       from ::= size-by-1;
  468.       -- if size = 0 then return; end;
  469.       loop until!(from < from_ind);
  470.      [to] := [from];
  471.      from := from - 1; -- Increments should be faster than using 
  472.      to := to - 1;     -- just one index and offseting it.
  473.       end;
  474.    end;
  475.    
  476.    private expand_to_size(new_size: INT): SAME is
  477.       -- Expand space so that the result has space for "new_size" elements.
  478.       -- Then set the location to new_size, indicating that it is filled
  479.       -- After this is done, the resulting array will be of size = new_size
  480.       -- and will have all the old elements of "self" copied over
  481.       -- and the remaining elements (if any) void
  482.       r: SAME;
  483.       if void(self) then r:=new(5.max(new_size))
  484.       elsif new_size<=asize then r:=self
  485.       else r:=new((2*asize).max(new_size)); 
  486.      r.loc:=loc;        -- Necessary?
  487.      i ::= 0; sz ::= size;    -- Copy over existing elements in self
  488.      loop until!(i = sz);
  489.         r[i] := [i] ;
  490.         i := i + 1;
  491.      end; -- clear;
  492.      SYS::destroy(self);     -- The old one should never be used.
  493.       end;
  494.       r.loc := new_size;
  495.       return r 
  496.    end;
  497.  
  498.    set!(e: T) is
  499.       loop aset!(e); yield; end;
  500.    end;
  501.    
  502.    fill(e: T) is
  503.       loop set!(e) end;
  504.    end;
  505.  
  506.    inds: ARRAY{INT} is 
  507.       res ::= #ARRAY{INT}(size);
  508.       loop res.set!(size.times!) end;
  509.       return res;
  510.    end;
  511.    
  512. end; -- class FLIST{T}
  513.  
  514. -------------------------------------------------------------------
  515.